COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(declare (setq defmacro-for-compiling ()) (*expr ttime dtime loadav))
C00006 ENDMK
C⊗;
(declare (setq defmacro-for-compiling ()) (*expr ttime dtime loadav))
;;; date and time processing

(defmacro pp-time ()
      `(let ((time (status daytime)))
	    (implode (append (pp-two-digits (car time))
			     '(|:|)
			     (pp-two-digits (cadr time))
			     '(|:|)
			     (pp-two-digits (caddr time))))))

(defmacro pp-date ()
      '(let ((date (status date))
	     (dow (exploden (status dow))))
	    (implode (append (pp-process-dow dow)
			     '(| |)
			     (pp-two-digits (cadr date))
			     '(|//|)
			     (pp-two-digits (caddr date))
			     '(|//|)
			     (pp-two-digits (car date))))))

(defmacro pp-two-digits (n)
	 `((lambda (n)
		   (declare (fixnum n))
		   (list (+ (car (exploden '|0|)) (quotient n 10.))
			 (+ (car (exploden '|0|)) (remainder n 10.))))
	   ,n))

(defmacro pp-process-dow (dow)
  `(let ((dow ,dow))
	(cons (car dow)
	      (do ((chars (cdr dow) (cdr chars))
		   (newchars () (cons (+ diff (car chars)) newchars))
		   (diff (- (car (exploden '|a|))
			    (car (exploden '|A|)))))
		  ((null chars)
		   (nreverse newchars))))))


(defmacro timer (name form . args)
	  `(defun ,name ,args
		  (terpri)
		  (princ "Timing performed on ")
		  (princ (pp-date))
		  (princ " at ")
		  (princ (pp-time))
		  (princ".")
		  ((lambda (t1 t2 t3 gt lb la)
			   ,form
			   (setq t1 (- (runtime) t1)
				 t2 (- (dtime) t2)
				 t3 (- (ttime) t3)
				 gt (- (status gctime) gt)
				 la (loadav))
			   (terpri)
			   (princ "Cpu (- GC) Time = ")
			   (princ (//$ (FLOAT  (- t1 gt))
					    1000000.0))
			   (terpri)
			   (princ "Elapsed Time = ")
			   (princ (//$ (float t2) 60.0))
			   (terpri)
			   (princ "Wholine Time = ")
			   (princ (//$ (float t3) 60.0))
			   (terpri)
			   (princ "GC Time = ")
			   (princ (//$ (float gt) 1000000.0))
			   (terpri)
			   (princ "Load Average Before  = ")
			   (princ lb)
			   (terpri)
			   (princ "Load Average After   = ")
			   (princ la)(terpri)
			   (princ "Average Load Average = ")
			   (princ  (//$ (+$ la lb) 2.0))(terpri))
		   (runtime) (dtime)(ttime)(status gctime)(loadav) 0)))

(*rset (nouuo ()))